This exercise aims to develop a Shiny application featuring an interactive choropleth map to analyze global trade networks in conjunction with the Big Mac Index. By integrating geographical data with economic indicators, the application will enable a visual exploration of how trade volumes and net exports correlate with price parity across different regions. The choropleth will serve as a dynamic tool to observe patterns, offering users the ability to drill down into country-specific trade connections and Index values.
The final deliverable will be a user-centric Shiny application, optimized for engagement and insight discovery. It will be complemented by a concise report summarizing the analytical narratives that emerge from the visualization. This endeavor will not only underscore the practicality of geospatial data in economic analysis but also aims to enrich the discourse on the implications of trade dynamics for market pricing mechanisms like the Big Mac Index.
1 Load Packages
For this Take Home Exercise, the focus will be on packages such as ggforce, igraph, ggraph and visNetwork.
Reading layer `TM_WORLD_BORDERS-0.3' from data source
`C:\FirGhaz\ISSS608-VAA\Take-home_Exercises\Take-Home_Ex04\data\geospatial\TM_WORLD_BORDERS-0.3.shp'
using driver `ESRI Shapefile'
Simple feature collection with 246 features and 11 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 83.6236
Geodetic CRS: WGS 84
Code
worldly_projected <-st_transform(worldly, "+proj=robin") data <-read_csv("C:/FirGhaz/ISSS608-VAA/Take-home_Exercises/Take-Home_Ex04/data/bmi_data_2021_carto.csv")
Code
map_pre <- worldly_projected%>%left_join(data)clean <- data%>%select(iso_a3 ='ISO3',bmi_usd_price=bmi_usd_price, total_trade=total_trade, import_usd=import_usd, export_usd,)# Join data to world mapmap <- map_pre%>%left_join(clean)%>%select(-c(country, id, year, continent, iso_a3))%>%mutate(across(c(bmi_usd_price:population), ~ifelse(is.na(.), 0, .)))#drop_na(bmi_usd_price)#st_write(map, "C:/FirGhaz/ISSS608-VAA/Take-home_Exercises/Take-Home_Ex04/data/map2021_data.csv")ggplot(map, aes(fill=total_trade))+geom_sf()
Code
dorl<-cartogram::cartogram_dorling( map, weight='total_trade', k =3,m_weight =1, itermax =1000)# Set colorscol_world <-"#9CB4BF"col_back <-"#1D201F"# Set themetheme_custom <-theme_void()+theme(plot.background =element_rect(fill=col_back,color=NA))dorl<-dorl%>%mutate(# Compute areaar=as.numeric(st_area(dorl)),# Compute radius based on arearad=as.numeric(sqrt(ar/pi)) )# Extract centroids for each circlecentr <- dorl%>%st_centroid()%>%st_coordinates()# Combine datadorl2 <-tibble(dorl,X=centr[,1],Y=centr[,2])%>%arrange(-total_trade)ggplot(map)+# World basemapgeom_sf( worldly,mapping=aes(geometry=geometry),fill=col_world,color=alpha("dimgrey",0.25) )+# Draw Dorling cartogram with geom_circle() ggforce::geom_circle(data = dorl2, aes(x0 = X, y0 = Y, r = rad),fill=alpha("dimgrey",0.75),color=alpha("white",0.2) )+ theme_custom
Code
dorl2 <- dorl2 %>%mutate(ratio_export = export_usd /total_trade,ratio_import = import_usd/total_trade )%>%mutate(rad_export=sqrt(rad*rad*ratio_export),rad_import=sqrt(rad*rad*ratio_import) )col_export <-"#f2e901"col_import <-"#FF4843"ggplot(map)+# World basemapgeom_sf( worldly,mapping=aes(geometry=geometry),fill=col_world,color=alpha("dimgrey",0.25) )+# Draw Dorling cartogram with geom_circle() ggforce::geom_circle(data = dorl2, aes(x0 = X, y0 = Y, r = rad),fill=alpha("dimgrey",0.75),color=alpha("white",0.2) )+# Draw circle for crops (or grass) ggforce::geom_circle(data = dorl2, aes(x0 = X, y0 = Y, r = rad_export),fill=col_export,color=NA )+ theme_custom
Code
circleFun <-function(center=c(0,0), # center of the circle diameter=1, # diameter npoints=100, # number of points to draw the circlestart=0, end=2# start point/end point ){ tt <-seq(start*pi, end*pi, length.out=npoints) tb <-tibble(x = center[1] + diameter /2*cos(tt), y = center[2] + diameter /2*sin(tt) )return(tb)}half_export <-bind_cols(ISO3 =rep(dorl2$ISO3[1],100),circleFun(c(dorl2$X[1],dorl2$Y[1]),dorl2$rad_export[1]*2, start=1.5, end=2.5 ))half_import <-bind_cols(ISO3 =rep(dorl2$ISO3[1],100),circleFun(c(dorl2$X[1],dorl2$Y[1]),dorl2$rad_import[1]*2, start=0.5, end=1.5 ))col_world <-"#9CB4BF"col_back <-"#1D201F"# Set themetheme_custom <-theme_void()+theme(plot.background =element_rect(fill=col_back,color=NA))# Make loop for all countriesfor (i in2:dim(dorl2)[1]){# Draw for exports temp_export <-bind_cols(ISO3 =rep(dorl2$ISO3[i],100),circleFun(c(dorl2$X[i],dorl2$Y[i]),dorl2$rad_export[i]*2, start=1.5, end=2.5 ))# Draw for imports temp_import <-bind_cols(ISO3 =rep(dorl2$ISO3[i],100),circleFun(c(dorl2$X[i],dorl2$Y[i]),dorl2$rad_import[i]*2, start=0.5, end=1.5 )) half_export<-half_export%>%bind_rows(temp_export) half_import<-half_import%>%bind_rows(temp_import)}df <-data.frame(x =1:3,y =c(3, 2, 1),group =c("A", "B", "C"))# Make mapp <-ggplot(map)+# World basemapgeom_sf( worldly,mapping=aes(geometry=geometry),fill=col_world,color=alpha("dimgrey",0.25) )+# Draw Dorling cartogram with geom_circle() ggforce::geom_circle(data = dorl2, aes(x0 = X, y0 = Y, r = rad),fill=alpha("dimgrey",0.75),color=alpha("white",0.2) )+# Draw half circle for crop with geom_polygongeom_polygon( half_export,mapping=aes(x,y,group=ISO3),fill=col_export,color=NA )+# Draw half circle for grass with geom_polygongeom_polygon( half_import,mapping=aes(x,y,group=ISO3),fill=col_import,color=NA )+ theme_customx_range <-range(dorl2$X, na.rm =TRUE)y_range <-range(dorl2$Y, na.rm =TRUE)# Calculate positions for legend items based on the rangelegend_x <- x_range[1] *1.20# Place legend slightly to the right of the X range minimumlegend_y_total_trade <- y_range[1] *1.15# Start legend slightly above the Y range minimumlegend_y_exports <- legend_y_total_trade +abs(y_range[2] - y_range[1]) *0.05# 5% above total tradelegend_y_imports <- legend_y_exports +abs(y_range[2] - y_range[1]) *0.05p +annotate("point", x = legend_x, y = legend_y_total_trade, shape =21, size =12, fill ="dimgrey", colour ="dimgrey" ) +annotate("text", x = legend_x +1, y = legend_y_total_trade, label ="Total Trade 1 billion(US)", hjust =0.52, vjust =1.6, colour ="grey", size=3.7, fontface ="italic", family ="Arial" ) +annotate("text", x = legend_x +1, y = legend_y_exports, label ="Exports", hjust =1.8, vjust =1.2, colour ="#f2e901", size=3.7,fontface ="italic", family ="Arial") +annotate("text", x = legend_x +1, y = legend_y_imports, label ="Imports", hjust =1.8, vjust =0.8, colour ="#FF4843", size=3.7, fontface ="italic", family ="Arial") +annotate("text", x = legend_x +1, y = legend_y_imports, label ="Trade 2021", hjust =1.16, vjust =-0.5, colour ="white", size=4.5, fontface ="bold", family ="Arial") + theme_custom
The provided image is a geo-network visualization that maps the global trade network for beef, highlighting the interconnected trade relationships of over 50 countries with a detailed focus on 28 of them. The visualization uses directional arcs and varying circle sizes to depict the flow and volume of beef exports and imports between nations. Such a graphic representation allows for a quick assessment of trade balances and intensities, with larger circles likely indicating major trade hubs or high trade volumes.
This visualization is particularly valuable in the context of economic studies, including the analysis of the Big Mac Index. The Big Mac Index is an informal benchmark used to compare the purchasing power between currencies by using the price of a Big Mac as a standard good. By overlaying the beef trade data, one can derive insights into local market prices of beef, a critical component of the Big Mac, hence affecting the index’s outcomes. For instance, beef-exporting countries might have cheaper Big Mac prices due to lower local beef costs, while importing countries could face higher prices reflecting the import costs.
Overall, the map serves as a powerful tool in illustrating how trade flows influence economic indicators like the Big Mac Index. It encapsulates the complexity of global trade in a digestible format, offering economists and decision-makers a clear visualization of how commodity movements impact local market economics and consumer prices. This, in turn, can guide more informed policy decisions and economic analyses.
Code
library(sf)library(ggplot2)library(ggforce) library(maps) library(geosphere)# Assuming 'bmi_node_2021' is your dataframe and it has columns 'LON' and 'LAT'# Make sure 'bmi_node_2021' is a data frame and 'LON' and 'LAT' are not factorsbmi_node_2021a <-data.frame(bmi_node_2021)bmi_node_2021a$LON <-as.numeric(as.character(bmi_node_2021a$LON))bmi_node_2021a$LAT <-as.numeric(as.character(bmi_node_2021a$LAT))# Convert your data frame to an sf objectnode_sf <-st_as_sf(bmi_node_2021a, coords =c("LON", "LAT"), crs =4326)node_sf_projected <-st_transform(node_sf, st_crs(worldly_projected))bmi_edges_2021$source_lon <-as.numeric(bmi_edges_2021$source_lon)bmi_edges_2021$source_lat <-as.numeric(bmi_edges_2021$source_lat)bmi_edges_2021$target_lon <-as.numeric(bmi_edges_2021$target_lon)bmi_edges_2021$target_lat <-as.numeric(bmi_edges_2021$target_lat)col_world <-"#9CB4BF"col_back <-"#1D201F"# Set themetheme_custom <-theme_void()+theme(plot.background =element_rect(fill=col_back,color=NA))# Create a LINESTRING for each row in bmi_edges_2021edges_linestrings <-lapply(1:nrow(bmi_edges_2021), function(i) { row <- bmi_edges_2021[i, ]st_linestring(matrix(c(row$source_lon, row$source_lat, row$target_lon, row$target_lat), ncol =2, byrow =TRUE))})# Convert the list of LINESTRINGs to an sf objectedges_sf <-st_sfc(edges_linestrings, crs =4326)# Convert to a data frame structure for sf, if needededges_sf_df <-st_sf(geometry = edges_sf)# Transform to the same CRS as the base mapedges_sf_projected <-st_transform(edges_sf_df, st_crs(worldly_projected))col.1<-adjustcolor("orangered", alpha=0.04)col.2<-adjustcolor("yellow", alpha=0.04)edge.pal <-colorRampPalette(c(col.1, col.2), alpha =TRUE)# Assuming 'Weight' is normalized between 0 and 1 for color mappingmax_weight <-max(bmi_edges_2021$Value, na.rm =TRUE)edge.col <-edge.pal(1000000)[round(1000000* bmi_edges_2021$Value / max_weight)]# Generate arc dataarc_data <-lapply(1:nrow(bmi_edges_2021), function(i) { row <- bmi_edges_2021[i,] arc <-gcIntermediate(c(row$source_lon, row$source_lat),c(row$target_lon, row$target_lat),n=300, addStartEnd=TRUE, breakAtDateLine=F )data.frame(lon = arc[,1], lat = arc[,2], weight = row$Value, edge_col = edge.col[i])}) %>%do.call(rbind, .)# Convert arc data to an sf object and projectarc_sf <-st_as_sf(arc_data, coords =c("lon", "lat"), crs =4326)arc_sf_projected <-st_transform(arc_sf, st_crs(worldly_projected))q <-ggplot(map) +geom_sf(data = worldly_projected, fill = col_world, color =alpha("dimgrey", 0.25)) +geom_sf(data = node_sf_projected, aes(geometry = geometry), color ="red", size =1) +geom_sf(data = arc_sf_projected, aes(color = edge_col), size =0.0001) +# Assuming 'edge_col' is part of 'arc_sf_projected'scale_color_identity() +# Draw Dorling cartogram with geom_circle() ggforce::geom_circle(data = dorl2, aes(x0 = X, y0 = Y, r = rad),fill=alpha("dimgrey",0.75),color=alpha("white",0.2) )+# Draw half circle for crop with geom_polygongeom_polygon( half_export,mapping=aes(x,y,group=ISO3),fill=col_export,color=NA )+# Draw half circle for grass with geom_polygongeom_polygon( half_import,mapping=aes(x,y,group=ISO3),fill=col_import,color=NA )+ theme_customx_range <-range(dorl2$X, na.rm =TRUE)y_range <-range(dorl2$Y, na.rm =TRUE)# Calculate positions for legend items based on the rangelegend_x <- x_range[1] *1.20# Place legend slightly to the right of the X range minimumlegend_y_total_trade <- y_range[1] *1.15# Start legend slightly above the Y range minimumlegend_y_exports <- legend_y_total_trade +abs(y_range[2] - y_range[1]) *0.05# 5% above total tradelegend_y_imports <- legend_y_exports +abs(y_range[2] - y_range[1]) *0.05q +annotate("point", x = legend_x, y = legend_y_total_trade, shape =21, size =9, fill ="dimgrey", colour ="dimgrey") +annotate("text", x = legend_x +1, y = legend_y_total_trade, label ="Total Trade 1 billion(US)", hjust =0.49, vjust =1.3, colour ="grey", size=3.5, fontface ="italic", family ="Arial" ) +annotate("text", x = legend_x +1, y = legend_y_total_trade, label ="Beef Trade --", hjust =0.97, vjust =2.6, colour ="orangered", size=3.5, fontface ="bold", family ="Arial" ) +annotate("text", x = legend_x +1, y = legend_y_exports, label ="Exports", hjust =1.8, vjust =0.9, colour ="#f2e901", size=3.5,fontface ="italic", family ="Arial") +annotate("text", x = legend_x +1, y = legend_y_imports, label ="Imports", hjust =1.8, vjust =0.6, colour ="#FF4843", size=3.5, fontface ="italic", family ="Arial") +annotate("text", x = legend_x +1, y = legend_y_imports, label ="Trade Network 2021", hjust =0.58, vjust =-0.6, colour ="white", size=4.3, fontface ="italic", family ="Arial") +theme_custom